perm filename SCMSS.F4[NEW,LCS]25 blob sn#550331 filedate 1980-12-15 generic text, type T, neo UTF8
C******  SCMSS *********** 12/1/75
	SUBROUTINE SCMSS
	COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1)
	1 /MKX/KSLA,ISM,LESS,IGT,NNO(5),MINUS
	COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,NOSET,
	1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB /JCHAR/IXX,ISEMI,IBLA
	1 /A2Z/LAA,LBB,A1(4),LGG,A2(6),LNN,LOH,A3(3),LSS,LTT,A4(4),LYY
	1 /NUM/NUM(9),N9
       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
	DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
C  /SCX/ ALSO IN WORDS, NEWR
	COMMON/SCX/JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
	1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
	1 /FRMT/F78F(1),FA1(1),FA5(1) /IDEV/IDEV
	1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
	1,NFLG,JXX,ISEMX,JG,VX(50),IAMP,K,KN,M,MODE,IBLX
      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
     1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
	1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
	1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
	1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
	1JALPHA(3))
C--THESE ARE IN 'RESTS' NOW.	DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/
	JDEV=IDEV
	JBKUP=0
C JBKUP IS TO TRAP MORE THAN ONE BACKUP IN A ROW.
1177	RB=0
	IF(JA.NE.140)GO TO 11
77	MODE=1
	IF(IDEV.NE.5)GO TO 177
C NEXT LOOKS FOR NAME TO SAVE INPUT  (TYPE 'INn NAME')
	DO 1377 K=3,72
	L=K
	IZ=INP(K)
1377	IF(IZ.LT.0)GO TO 2377
C JUMP OUT IF LETTER FOUND FIRST
	NAMSC='INPUT'
	GO TO 3377
2377	CALL NAMEXT(INP(L),NAMSC,K)
3377	CALL OFILE(21,NAMSC)
C12/80	WRITE(21,2114)INP
	CALL INPOUT
C WRITE OUT 'IN' ETC.
177	IBEAM=-1
	IZ=0
	POS2=0
	POS1=0
CC	THIS IS SET IN MSX NOW ****  RMODE2=R3
91	CALL TYPCRL
	CALL TYPSTR('STAFF=')
	CALL TYPFLT(STAFF)
	IF(SET4.EQ.999.)GO TO 911
912	CALL TYPSTR('    SPACING STAFF=')
	CALL TYPFLT(SET4)
911	CALL TYPCRL
	GO TO 111 

11	RB=0
	IF(MODE.LE.2)GO TO 111
	IF(IDEV.EQ.1)GO TO 111
C SKIP IF READING AN EDIT FILE
	CALL DPYOUT(3)
	CALL ACCPOG(1)
	CALL DPYOUT(1)
C THIS TO DISPLAY NOTE NUMS. ON DATA-DISK.
	GO TO 111
467	IDEV=5
	GO TO 4333
444	SET4=RA
	GO TO 912
111	CALL SETUP
	IF(STUP.GE.0)GO TO 8
C SKIPS IF USING SETUP ON SOME STAFF
	IF(POS2.NE.0)GO TO 4334
C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP  ST  POS1  POS2  X)
4333  	IF(IDEV.EQ.5)CALL TYPSTR('TYPE POS1, POS2, (SPC)  ')
	READ(IDEV,F78F,END=467)POS1,POS2,PSFB
C 'REREAD' IS NEEDED BECAUSE OF SOME FORTRAN BUG!!!!!!!!!!!!!!!!!!!!!!
C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
	REREAD 2114,INP
C	IF(IDEV.NE.5)GO TO 5333
C	WRITE(21,2114)INP
	IF(IDEV.EQ.5)CALL INPOUT
C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
C WRITE OUT SPACING INFO
5333	CALL A2READ(K,RA)
	IF(K.EQ.'SP')GO TO 444
C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
	IF(K.EQ.IAT)GO TO 467
CATCH '@' WHEN POS1 AND P2 ARE EXPECTED.
	IF(K.EQ.LESS)GO TO 467
	IF(K.NE.IGT)GO TO 567
	IDEV=1
	GO TO 4333
567	IF(POS2.EQ.0)POS2=200.
	IF(POS1.GE.POS2)GO TO 4333
C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
	IF(INP1.GT.0)GO TO 4334
CCC NOW FOUND LETTER WHERE WE WANT NUMB.
	IF(IDEV.EQ.5)GO TO 4333
	CALL TYPSTR(' POS1, POS2 MISSING')
	CALL TYPCRL
	GO TO 999
4334	STUP=STUP-PSFB

8	CALL TYPCRL
367	GO TO (1,2,3,4,5,677)MODE
	GO TO 80041

2111	IDEV=JDEV
	RETURN
CC168	IF(NOSET.EQ.0)RETURN

80052	FORMAT(F,A4,A5,2F)
267	IDEV=5
	IF(MODE.EQ.3)CALL NOTNUM
	GO TO 2111
4	IF(IDEV.EQ.5)CALL TYPSTR('ADD BEAMS?  ')
330	READ(IDEV,2114,END=677)INP
	CALL LULOOP
	IF(INP1.EQ.LGG)GO TO 677
C  TYPE 'GO' TO PASS LATER ITEMS
	IF(INP1.EQ.N9.AND.INP2.EQ.INP1)GO TO 99
	IF(INP1.EQ.LBB)GO TO 99
	IF(INP1.EQ.LYY)GO TO 1
C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
	IF(INP1.EQ.LNN)GO TO 2000
	IF(INP1.EQ.ISEMI)GO TO 2000
	IF(INP1.EQ.LESS)GO TO 267
	IF(INP1.NE.IGT)GO TO 767
	IDEV=1
766	GO TO(1,2,3,4,5)MODE
767	IF(INP1.NE.IBLA)GO TO 5177
2000	MODE=MODE+1
	IF(IDEV.EQ.5)WRITE(21,2114)INP4
	GO TO 11
690	REND=1
	GO TO 2111
3	IF(IDEV.EQ.5)CALL TYPSTR('ADD MARKS?  ')
	GO TO 330
5	IF(IDEV.EQ.5)CALL TYPSTR('ADD SLURS?  ')
	GO TO 330

8006	MODE=MODE+1
	IF(MODE.GT.5)GO TO 677
	IF(IDEV.NE.5)GO TO 367 
C RETURN ONLY IF IN TTY MODE. (NOT READING A FILE)
	GO TO 2111
677	IF(IDEV.NE.5)GO TO 68
	END FILE 21
	CALL TYPSTR('INPUT SAVED ON ')
	CALL TYPSTR(NAMSC)
	CALL TYPSTR('.DAT')
	CALL TYPCRL
68	REND=-1
	GO TO 2111

99	IF(INP3.EQ.N9)GO TO 999
C ELSE GET ANOTHER CHANCE TO SAY 'NO'.  99=BACKUP,  999=ESCAPE
	IF(MODE.GE.4)GO TO 1999
	IF(JBKUP.LT.0)GO TO 199
	JBKUP=-1
	MODE=MODE-1
	IF(MODE.EQ.0)GO TO 999
	IS=ISV(MODE)
	GO TO 11
C  INSERT BACKUP ROUTINE
999	REND=99
	GO TO 2111
C FIX BACKUPS********
199	CALL TYPSTR('ONLY 1 BACKUP AT A TIME.  ')
299	CALL TYPSTR('CONTINUE, THEN EDIT .DAT FILE LATER, OR TYPE 999.')
	CALL TYPCRL
	GO TO 367
1999	CALL TYPSTR('CANNOT BACKUP AFTER MARKS INPUT.')
	CALL TYPCRL
	GO TO 299

8015	RA=0
	DO 15 J=1,I-1
15	RA=RA+4./V(J)
	K=IRHY-I+1
	CALL TYPSTR('TOTAL RHY=')
	CALL TYPFLT(RA)
	CALL TYPSTR(' QTRS. ')
	CALL TYPINT(K)
	CALL TYPSTR(' MORE RHYTHMS NEEDED')
	CALL TYPCRL
	IDEV=5
C RETURNS TO TTY MODE IF READING A FILE WITH 'FILE' FEATURE.
2	IF(IDEV.EQ.5)CALL TYPSTR('TYPE ')
	CALL TYPINT(IRHY)
	CALL TYPSTR(' RHYTHMS')
	CALL TYPCRL

1	ISV(MODE)=IS
	CALL TYPE
CC	IF(MODE.EQ.2)CALL RHQUIK
C RHQUIK ALLOWS TYPING RHYTHMS ON BOTTOM LEVEL OF KYBD.
C Z=WHOLE, X=HALF, C=QUARTER, V=EIGHTH, B=SIXTEENTH.
	IF(INP1.NE.IAT)GO TO 1001
C '@' STARTS MODE2 INPUT
	IF(INP2.NE.IBLA)GO TO 1001
C BUT NOT IF IT'S REALLY A MOTIVE CALL
	IF(IDEV.EQ.5)END FILE 21
C CLOSE THE BACKUP FILE
	CALL PRESCN
	CALL IFILE(22,'MODE2')
	READ(22,2114)INP
	CALL LULOOP
	IDEV=22
C IDEV  CHANGES BACK BEFORE RETURN TO MAIN.
	Z=STUP
	CALL SETUP
C MUST RECALL SETUP BECAUSE SOME ARRAYS WERE USED IN PRESCN.(??)
	STUP=Z
	GO TO 6177
1001	CALL LULOOP
	CALL A2READ(RA,RB)
	IF(RA.NE.'SP')GO TO 5177
	SET4=RB
C CAN SET SPACER HERE
	GO TO 1177
5177	IF(INP1.EQ.IBLA) GO TO 1
	IF(INP1.NE.N9)GO TO 80041
	IF(INP2.EQ.N9)GO TO 99
C  TYPE '99' TO BACK-UP
80041	IF(IDEV.EQ.5)CALL INPOUT
C12/80  80041	IF(IDEV.EQ.5)WRITE(21,2114)INP
6177	CALL LNEND
	IF(INP1.EQ.ISEMI)GO TO 7774
C INP1=; MEANS UNTERMINATED LINE WAS TYPED.  GO TRY AGAIN.
	GO TO(333,433,533)MODE-2
C GO TO MARKZ, BEAMS, SLURZ
	RETRO=-1.
	I=1
	PARENS=0
	MOT=0
      JZ=1  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      KL=0  
      RA=0  
	IF(MODE.EQ.2)GO TO 2408
C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
	IF(INP1.NE.LSS)GO TO 2408
	IF(INP2.NE.LTT)GO TO 2408
	K=1
	L=3
	IF(INP3.NE.MINUS)GO TO 1277
	K=-1
	L=4
1277	STAFF=NALF(INP(L))*K
2277	MLX=L+1
	IF(INP(MLX).NE.KSLA)GO TO 2277
	MLX=MLX+1
	GO TO 3277
2408	MLX=1
3277	L=-1
C   GO SORT OUT THE NEW FORMAT
	DO 2999 K=1,72
	N=INP(K)
	IF(N.EQ.IBLA)GO TO 2999
	L=0 
	IF(N.EQ.ISTAR)GO TO 277
	IF(N.NE.ISEMI)GO TO 2999
C  READS 72 CHARS. INCLUDING ;.
277	INP(K+1)=ISEMI
	GO TO 1773
C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
2999	CONTINUE
7774	CALL TYPSTR('****** TRY AGAIN ***** ')
	CALL TYPCRL
	GO TO 766
CC	GO TO 1

1299	IF(JZ.NE.0)GO TO 1773
7773	CALL TYPE
CC	IF(MODE.EQ.2)CALL RHQUIK
C FOR Z=W, X=H, C=Q  RHYTHMS, ETC.

	IF(INP1.EQ.IBLA)GO TO 7773
	IF(IDEV.EQ.5)CALL INPOUT
C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
	CALL LULOOP
77732	CALL LNEND
	JM=-1
	JZ=0
	GO TO 2408
C   'LISTS' MUST END WITH ; 
1773	JZ=0
	DBST=1.
	IF(XDBST)DBST=-DBST
	XDBST=0
17731	ML=MLX
	IF(PARENS.LE.0.)GO TO 975
C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
3362	PARENS=0
	MOT=I-LMOT
	IF(LCNT+MOT.LT.198)GO TO 33621
	CALL TYPSTR(' NO ROOM FOR MOTIVE ')
	CALL TYPCHR(JMOT,1)
	CALL TYPCRL
	GO TO 1
33621	JLIST(LCNT+1)=MOT
	LCNT=LCNT+2
	DO 2140 JG=0,MOT-1
2140	RLIST(LCNT+JG)=V(LMOT+JG)
	LCNT=LCNT+MOT
	IF(IAMP)GO TO 3013
C  FOR CLOSE PARENS ON LAST ITEM
C   STORE MOTIVE IN RLIST ARRAY

975	DO 236 JDD=ML,72
	JD=JDD
	N=INP(JD)
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
	IF(N.EQ.ILP)GO TO 477
	IF(N.EQ.IRP)GO TO 477
	IF(N.NE.ICOL)GO TO 2361
477	INP(JD)=IBLA
	IF(N.NE.ICOL)GO TO 1113
	XDBST=-1.
	GO TO 5362
C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
1113	L=JD-1
5113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 5113
2113	IF(N.EQ.IRP)GO TO 3361
C  ONLY ONE () AS YET,  NO NESTING
1140	JMOT=INP(L)
C   MOTIVE NAME
	DO 11401 JC=1,LCNT-1
	IF(JMOT.NE.JLIST(JC))GO TO 11401
C  FINDS DUPLICATE IDENTIFIER
	CALL TYPSTR(' MOTIVIC (')
	CALL TYPCHR(JMOT,1)
	CALL TYPSTR(') USED TWICE')
	CALL TYPCRL
	JLIST(JC)=0
C  ZERO OUT PREVIOUS USE OF IDENTIFIER.
11401	CONTINUE
	JLIST(LCNT)=JMOT
	PARENS=-1.
C   A PARENTH IS OPEN
	INP(L)=IBLA
	LMOT=I
C   LMOT IS CURRENT POINT IN V ARRAY
	GO TO 236
3361	IF(PARENS.NE.0)GO TO 33612
	CALL TYPSTR('PARENTH ERROR - GOING ON')
	CALL TYPCRL
33611	INP(JD)=IBLA
	GO TO 236
33612	PARENS=1.
C   SETS PARENS CLOSED FLAG
	GO TO 33611
C   NO INVERSIONS POSSIBLE NOW
2361	IF(N.NE.IAT)GO TO 5361
	DO 113 L=1,72
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.NEG)GO TO 7113
	RETRO=0
	INP(K)=IBLA
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 L=1,LCNT
	IF(JG.NE.JLIST(L))GO TO 6361
	VX1=0
	DO 40 M=JD+2,72
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	IF(JG.EQ.KSLA)GO TO 140
	IF(JG.EQ.ISEMI)GO TO 140
	IF(JG.EQ.ISTAR)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JM
	JM=-1
	INP(K)=IBLA
	JN=0
C   MUST BE ZERO IN SCANR
	CALL SCANR
	JM=JC
140	JC=1
	KN=L+2
	M=KN+JLIST(L+1)
	IF(RETRO)GO TO 940
	KN=M-1
	M=L+1
	JC=-1
	RETRO=-1.

940	Z=RLIST(KN)
	IF(VX1.EQ.0)GO TO 540
C  " @Q N "  WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
	IF(MODE.EQ.1)GO TO 440
C  MODE 1 IS NOTES, 2 IS RHY.
	V(I)=Z*VX1
	GO TO 7361
440	IF(ABS(Z).GE.2000.)GO TO 540
C  SKIPS NON-NOTES
	RB=VX1
	IF(Z)RB=-RB
C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
C  NEG NUMS ARE CHORD NOTES.
	V(I)=Z+RB
	GO TO 7361
540	V(I)=Z
7361	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	RB=V(I-1)
	DO 8361 LI=JD,72
	JG=INP(LI)
	INP(LI)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.ISEMI)GO TO 93611
8361	IF(JG.EQ.ISTAR)IAMP=-1
9361	MLX=LI
	IF(IAMP.EQ.0)GO TO 17731
	JZ=-1
93611	IF(IAMP)GO TO 3013
	GO TO 7773
6361	CONTINUE
	CALL TYPSTR(' MOTIVIC (')
	CALL TYPCHR(JG,1)
	CALL TYPSTR(') NOT FOUND')
	CALL TYPCRL
	GO TO 11401
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.NE.KSLA)GO TO 636
5362	MLX=JD+1
	JZ=-1
	INP(JD)=ISEMI
436	IF(INP(MLX).NE.IBLA)GO TO 103
	MLX=MLX+1
	GO TO 436
636	IF(N.EQ.ISEMI)GO TO 103
936	IF(N.NE.IDOT)GO TO 736
	L=INP(JD+1)
	KL=NALF(L)
	IF(L.LE.0)GO TO 577
	IF(KL.LT.0)GO TO 577
	IF(KL.LE.9)GO TO 236
C   JUMP IF IT'S A NUMBER
577	IF(MODE.EQ.2)INP(JD)=1
C :::::::::******* ↑↑↑↑ MODE #?
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
736	IF(N.NE.ISTAR)GO TO 236
	IAMP=-1
	INP(JD)=ISEMI
	GO TO 103
236	CONTINUE

2114	FORMAT(72A1)
CC21141	FORMAT(I,72A1)

5016	IF(IAMP.GE.0)GO TO 1299
	IF(PARENS.NE.0)GO TO 3362
C  PARENS ARE STILL OPEN?
	GO TO 3013
103	K=INP(ML)

C   LAST SECTION
	IF(K.EQ.ISEMI)GO TO 1014
C*********** MODE #?
	IF(K.NE.IBLA) GO TO 1899
	ML=ML+1
	GO TO 103
1899	JN=0
C   MUST BE ZERO IN SCANR
	VX4=0
	NOAC=0
	CALL SCANR
      IF(VX1.EQ.-99.)GO TO 4022
C NO MORE COMPOSITES IN RHYTH.  DOTS ARE INDICATED BY 100S.
C RHYTH. NUMB IS KEPT HERE.  DOTTED QUARTER IS NOW 104. DBL..=204
17	IF(MODE.NE.2)GO TO 117
	IF(JJ.EQ.1)GO TO 117
	IF(VX2.EQ.0)GO TO 117
C VX2=0 IF "X" IS USED.  (8X3  FORMS VX1=8, VX2=0, VX3=3)
	RB=0
	DO 2117 K=1,JJ
2117	RB=RB+4./VX(K)
	VX1=4./RB
C FOR COMPOSITE RHYTHMS. (USEFUL FOR 'WHOLE' RESTS IN 5/4, ETC.)
	JJ=1
117	V(I)=VX1
	IF(VX4.EQ.0)GO TO 115
	IF(MODE.NE.1)GO TO 115
	I=I+1
C  FOR + OR -.  AUTO OCTAVES, ETC.
	V(I)=-VX1-VX4
115	IF(JJ.LE.1)GO TO 114
	IF(MODE.NE.1)GO TO 171
	IF(VX2.EQ.0)GO TO 171
C  JUMP IF RHY OR 'X 4' ETC.
	V(I)=18000.0+VX1*10.0+VX2/10.0
C  PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n  xy=top, zn=bottom)
114	I=I+1
	GO TO 5016
171	JC=1
	JD=VX(JJ)-1
	I=I+1
	GO TO 5005
1014	JD=1
	JC=1
C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
	GO TO 5005
4022      JC=VX2+.3
      JD=VX3-.5
	IF(MODE.EQ.1)NOAC=-1
C ACCIS WILL NOT!! REPEAT UNLESS 100 IS ADDED TO 1ST NUM.******6/78
	IF(JJ.EQ.2)JD=1
C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
	IF(JC.LT.100)GO TO 5005
C ADD 100 TO NUM OF NOTES TO REPEAT ACCIS WITH 'REP N1, N2'.
	JC=JC-100
	NOAC=0
5005	N=0
	DO 3005 K=I-1,1,-1
	IF(V(K))GO TO 3005
	IF(V(K).LT.3000)N=N+1
C  COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
3005	IF(N.EQ.JC)GO TO 4005
4005	IF(JC.GT.1)GO TO 7005
	IF(MODE.EQ.1)NOAC=-1
C 5/76 *******   AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
C  ACCIS ARE DROPPED WITH / OR Xn REPEAT.  (BUT NOT WITH 'REP' OR '/X n,n/')
7005	JC=I-K
C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
	DO 1005 K=1,JD    
       NL=I+JC-1  
      DO 2005 L=I,NL    
	KN=L-JC
	RB=V(KN)
	IF(NOAC.GE.0)GO TO 2005
	IF(ABS(RB).GE.2000)GO TO 2005
C  SKIP OVER IF NOT A NOTE
	RB=AMOD(RB,100.0)+1000.0
	IF(V(KN))RB=RB-2000.0
C  DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
2005	V(L)=RB
1005      I=I+JC  
      GO TO 5016  

3013	IF(MODE.NE.2)GO TO 771
	IF(I-1.NE.IRHY)GO TO 8015
C  WRONG NUMBER OF ITEMS
771	V(I)=-99.
	IF(MODE.NE.1)GO TO 132
C  FOR ADDED NOTES ON SPACING STAFF
	CALL NOTES
C SAVES TOTAL OF ITEMS FOR LABEL 168
67	CALL NEWR
	IX=IS
C SAVE PTR TO RN ARRAY FOR TREM. OVER BEAM LATER. (IN 'BEAMS.F4')
	GO TO 8006
132	CALL RHYTH
C  =50 IS RHYTHM FOR TEXT
	GO TO 67
134	IF(IDEV.EQ.5)CALL INPOUT
C12/80  134	IF(IDEV.EQ.5)WRITE(21,2114)INP
C  WRITES TYPED IN REPLY TO 'ADD BEAMS?'
C   ACCENTS ARE IN MARKZ SUBROUTINE
	GO TO 8006
533	CALL SLURZ
	GO TO 8006
433	CALL BEAMS
C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
	IBEAM=0
	GO TO 8006
333	CALL MARKZ
135	K=IS
	CALL NEWR
	IS=K
C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
	GO TO 8006
	END

	SUBROUTINE A2READ(A,B)
	REREAD 1,A,B
	CALL LO2UP(A)
1	FORMAT(A2,F)
	END
	SUBROUTINE INPOUT
C WRITES TYPED INPUT TO FILE 'INPUT.DAT' (OR OTHER NAME)
	COMMON /ALF/INP(1)
	DO 1 K=72,1,-1
1	IF(INP(K).NE.' ')GO TO 2
	K=1
2	WRITE(21,2114)(INP(J),J=1,K)
2114	FORMAT(72A1)
	END